Copyright (c) 2011-2013, bkil.hu
This program is free software and can be distributed under the terms of
the GNU General Public License v2,
see COPYING for detailed licensing terms.
created on 2011-03-21

compile with the following to enable SMP:
ghc -O2 -threaded -with-rtsopts="-N" minichess.lhs

> import Data.List(partition)
> import Data.Char(chr)
> import Control.Parallel.Strategies(parList, using, rdeepseq)

--data Move = Move Int Int
newtype Move = (Int,Int)
data PieceT = Single [Move] | Vector [Move]

> type PieceI = Int
> type Owner = Int
> type Coord = (Int,Int)
> type Pieces = [(Owner,PieceI,Coord)]

data PieceT = [
 Single 'K' [[(-1,-1), (0,-1), (1,-1), (-1,0), (0,-1), (1,-1), (1,0), (1,1)]
 Vector 'Q' [[(-1,-1), (0,-1), (1,-1), (-1,0), (0,-1), (1,-1), (1,0), (1,1)]
 Single 'N' [(-2,-1), (-2,1), (-1,-2), (-1,2), (1,-2), (1,2), (2,-1), (2,1)]
 Vector 'B' [(-1,-1), (-1,1), (1,-1), (1,1)]
 Vector 'R' [(-1,0), (0,-1), (0,1), (1,0)]
 Single 'P' [(0,1)] ]

-

> rules :: [[Coord]]
> rules = [[(-2,-1), (-2,1), (-1,-2), (-1,2), (1,-2), (1,2), (2,-1), (2,1)],
>          [(-1,-1), (-1,1), (1,-1), (1,1)],
>          [(-1,0), (0,-1), (0,1), (1,0)]]

> pieces :: Pieces
> pieces = [(1,0,(2,0)), (1,1,(1,0)), (1,2,(2,0)),
>           (-1,1,(0,3)), (-1,0,(1,3)), (-1,2,(2,3))]

> dim = 4 :: Int

 01234567
0K
1N
2
3
4    K
5
6
7

> main :: IO()
> main = turn 0 1 pieces

> turn :: Int -> Owner -> Pieces -> IO ()
> turn n o pieces = do
>  print n
>  printPieces pieces
>  print o
>  let (k,p') = value (n `div` 20+7-length pieces) o pieces
>  print k
>  if p'/=pieces then turn (n+1) (-o) p' else return ()

> printPieces pieces = do
>  print pieces
>  putStr $ unlines $ map show $ table pieces

> table :: Pieces -> [[Char]]
> table pieces =
>  [[ case [chr(t+65+16*(o+1)) | (o,t,(x',y'))<-pieces, x'==x, y'==y] of
>        [c]->c;_->' ' |
>     x <- [0..dim-1]] | y <- [0..dim-1] ]

> value :: Int -> Owner -> Pieces -> (Int, Pieces)
> value 0 o p = (sum $ map (\(o',t,(x,y)) -> (x+y-10*dim*(3-t))*o'*o) p,p)
> value n o p = case steps o p of
>     [] -> (-999-10*dim*n, p)
>     ps -> let each l = l `using` parList rdeepseq
>               vals = [(value (n-1) (-o) p',p') | p' <- ps]
>               ((k,_),p'') = minimum $ each vals in (-k,p'')

> steps :: Owner -> Pieces -> [Pieces]
> steps o pieces =
>  [(o,t,xy') : rest | p@(o',t,xy) <- pieces, o'==o, ps <- [filter (/=p) pieces],
>             Just xy' <- map (add xy) (rules !! t),
>             (capture,rest) <- [partition (\(_,_,xy'')-> xy'' == xy') ps],
>             case capture of [(o'',_,_)] -> o''/=o; _ -> True
>                    ]

> add :: Coord -> Coord -> Maybe Coord
> add (x,y) (u,v) | x+u>=0 && x+u<dim && y+v>=0 && y+v<dim = Just (x+u,y+v)
> add _ _ = Nothing
